home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: delta / whiteline CD Series - delta.iso / progtool / modula2 / module / popupmen.mod < prev    next >
Text File  |  1995-11-25  |  7KB  |  195 lines
  1. IMPLEMENTATION MODULE  PopUpMenue;
  2.  
  3. FROM SYSTEM IMPORT TSIZE,ADDRESS,VAL,ADR;
  4.  
  5. FROM EasyDialog IMPORT GetObjectXYWH,SetObjectXYWH,and,WorkTree,TreePROC;
  6.  
  7. FROM Strings    IMPORT RightStr,EqualStr,Concat,Length;
  8.  
  9. FROM KbdEvnt IMPORT ConcatScanString;
  10.  
  11. FROM BitBlt IMPORT CopyScreenToMem,CopyMemToScreen;
  12.  
  13. FROM AES IMPORT ObjectFind,ObjectDraw,ObjectChange,EventMultiple,
  14.                 WindowGet,GrafMouse;
  15.  
  16. FROM GEMAESBase IMPORT Object,Disabled,Selected,Checked,GraphicString,
  17.                        WorkXYWH,MouseOff,MouseOn,ButtonEvent,KeyboardEvent,
  18.                        TimerEvent;
  19.  
  20. VAR MenuString,ScanString : ARRAY [0..7] OF CHAR;
  21.     Item,Laenge : INTEGER;
  22.  
  23. PROCEDURE GetObjectState(Index:INTEGER; TreePtr:ADDRESS):INTEGER;
  24. VAR     Probe   :POINTER TO Object;
  25. BEGIN
  26.     Probe:=TreePtr+VAL(ADDRESS, (Index*TSIZE(Object)));
  27.     RETURN Probe^.state;
  28. END GetObjectState;
  29.  
  30. PROCEDURE PopUpMenuItemCheck(Tree : ADDRESS; Item :INTEGER; Check :BOOLEAN);
  31. (* Display or erase a check mark next to a menu item *)
  32.  VAR x,y,w,h :CARDINAL;
  33. BEGIN
  34.   GetObjectXYWH(0,Tree,x,y,w,h);
  35.   IF Check THEN
  36.     IF ~and(GetObjectState(Item,Tree),Checked) THEN
  37.         ObjectChange(Tree,Item,0,x,y,w,h,GetObjectState(Item,Tree)+Checked,0);
  38.     END(*IF*);
  39.   ELSE
  40.     IF and(GetObjectState(Item,Tree),Checked) THEN
  41.         ObjectChange(Tree,Item,0,x,y,w,h,GetObjectState(Item,Tree)-Checked,0);
  42.     END(*IF*);
  43.   END(*IF*);
  44. END PopUpMenuItemCheck;
  45.  
  46. PROCEDURE PopUpMenuItemEnable (Tree: ADDRESS; Item:INTEGER;  Enable: BOOLEAN);
  47. (* Enables or disables a menu item *)
  48.  VAR x,y,w,h :CARDINAL;
  49. BEGIN
  50.   GetObjectXYWH(0,Tree,x,y,w,h);
  51.   IF ~Enable THEN
  52.     IF ~and(GetObjectState(Item,Tree),Disabled) THEN
  53.         ObjectChange(Tree,Item,0,x,y,w,h,GetObjectState(Item,Tree)+Disabled,0);
  54.     END(*IF*);
  55.   ELSE
  56.     IF and(GetObjectState(Item,Tree),Disabled) THEN
  57.         ObjectChange(Tree,Item,0,x,y,w,h,GetObjectState(Item,Tree)-Disabled,0);
  58.     END(*IF*);
  59.   END(*IF*);
  60. END  PopUpMenuItemEnable;
  61.  
  62. PROCEDURE PopUpMenuText (Tree: ADDRESS; Item: INTEGER; Text: ARRAY OF CHAR);
  63. (* Changes the text of a menu item *)
  64. (* funktioniert nur nicht so wie ich mir das vorstellte ! *)
  65.  VAR i       : INTEGER;
  66.      Probe   : POINTER TO Object;
  67.      s       : POINTER TO ARRAY [0..40] OF CHAR;
  68. BEGIN
  69.   Probe:=Tree+VAL(ADDRESS, (Item*TSIZE(Object)));
  70.   IF Probe^.type=GraphicString THEN
  71.   s:= Probe^.spec;
  72.     IF HIGH(Text)>39 THEN
  73.         FOR i:=0 TO 39 DO
  74.             s^[i]:=Text[i];
  75.         END(*FOR*);
  76.         s^[40]:=0C;
  77.     ELSE
  78.         FOR i:=0 TO HIGH(Text) DO
  79.             s^[i]:=Text[i];
  80.         END(*FOR*);
  81.         s^[HIGH(Text)]:=0C;
  82.     END(*IF*);
  83.   END(*IF*);
  84. END  PopUpMenuText;
  85.  
  86. PROCEDURE SearchPopMenuTree(MenuTree:ADDRESS; Index :INTEGER);
  87. VAR
  88.       MenuObject  : POINTER TO Object;
  89.       s           : POINTER TO  ARRAY [0..40] OF CHAR;
  90.       OK          : BOOLEAN;
  91. BEGIN
  92.         s:=ADR(MenuString);
  93.         MenuObject:=MenuTree+ VAL(ADDRESS,(Index*TSIZE(Object)));
  94.         IF (MenuObject^.type=GraphicString) AND ~and(MenuObject^.state,Disabled) THEN
  95.             s:=MenuObject^.spec;
  96.             RightStr(s^,Laenge,MenuString,OK);
  97.             IF OK AND EqualStr(ScanString,MenuString)THEN
  98.                 Item:=Index;
  99.             END(*IF*);
  100.         END(*IF*);
  101. END SearchPopMenuTree;
  102.  
  103.  
  104. PROCEDURE UpDate(Tree :ADDRESS;Last,new :INTEGER);
  105.  VAR x,y,w,h :CARDINAL;
  106. BEGIN
  107.    GetObjectXYWH(0,Tree,x,y,w,h);
  108.    IF Last>0 THEN
  109.          IF ~and(GetObjectState(Last,Tree),Disabled)
  110.              AND  and(GetObjectState(Last,Tree),Selected) THEN
  111.              ObjectChange(Tree,Last,0,x-1,y-1,w+4,h+4,GetObjectState(Last,Tree)-Selected,1);
  112.          END(*IF*);
  113.    END(*IF*);
  114.    IF new>0 THEN
  115.          IF ~and(GetObjectState(new,Tree),Disabled)
  116.              AND  ~and(GetObjectState(new,Tree),Selected) THEN
  117.              ObjectChange(Tree,new,0,x-1,y-1,w+4,h+4,GetObjectState(new,Tree)+Selected,1);
  118.          END(*IF*);
  119.    END(*IF*);
  120. END UpDate;
  121.  
  122. PROCEDURE PopUp(x,y:INTEGER; PopTree :ADDRESS ) : INTEGER;
  123. VAR dx,dy,dw,dh : CARDINAL;
  124.     wx,wy,ww,wh : INTEGER;
  125.     Akt,Last,MouseX,MouseY,Keystate,
  126.     Scancode,Mouseclicks :INTEGER;
  127.     Buffer : ADDRESS;
  128.     MsgBuf : ARRAY [0..7] OF INTEGER;
  129.     Clicks,event,Mousebutton : INTEGER;
  130.     search              :TreePROC;
  131.  
  132. BEGIN
  133.     search:=SearchPopMenuTree;
  134.     GetObjectXYWH(0,PopTree,dx,dy,dw,dh);
  135.     WindowGet(0,WorkXYWH,wx,wy,ww,wh);
  136.     (* Wenn das Objekt nicht komplett auf den Bildschirm passt     *)
  137.     (* werden die Koordinaten x,y so verschoben das es vollständig *)
  138.     (* darstellbar ist                                             *)
  139.     IF (wx+ww)<(x+VAL(INTEGER,dw)) THEN
  140.        x:=(wx+ww)-VAL(INTEGER,dw);
  141.     END(*IF*);
  142.     IF (wy+wh)<(y+VAL(INTEGER,dh)) THEN
  143.        y:=(wy+wh)-VAL(INTEGER,dh);
  144.     END(*IF*);
  145.     SetObjectXYWH(0,PopTree,x,y,dw,dh);
  146.     (* Bildschirmhintergrund retten für Redraw *)
  147.     GrafMouse(MouseOff,NIL);
  148.     CopyScreenToMem(x-2,y-2,dw+6,dh+6,Buffer);
  149.     ObjectDraw(PopTree,0,8,x-1,y-1,dw+4,dh+4);
  150.     GrafMouse(MouseOn,NIL);
  151.     Last:=0;Akt:=0;
  152.     REPEAT
  153.          event:= EventMultiple(ButtonEvent+KeyboardEvent+TimerEvent,
  154.                        01,03,01, (* wartet auf Mausclicks *)
  155.                        0,0,0,0,0,0,0,0,0,0,
  156.                        ADR(MsgBuf),(* hier bedeutungslos *)
  157.                        50,0, (* alle 50 ms wird die neue Position der Maus abgefragt *)
  158.                        MouseX,MouseY,
  159.                        Mousebutton,Keystate,Scancode,Mouseclicks);
  160.  
  161.          Last:= Akt;
  162.          (* Wo ist die Maus ?*)
  163.          Akt:=ObjectFind(PopTree,0,8,MouseX,MouseY);
  164.          IF event = KeyboardEvent THEN  (* Tastaturunterstützung in PopupMenüs sieht genauso aus wie in normalen Menüs *)
  165.             MenuString:=' ';ScanString:=' ';
  166.             ConcatScanString(ScanString,Keystate,Scancode);
  167.             Item:= -1;
  168.             Laenge:=Length(ScanString);
  169.             WorkTree(PopTree,0,0,search);
  170.             (* Wenn Shortcut gefunden dann anclicken des Menüeintrages simulieren*)
  171.             IF Item >0 THEN
  172.                 event:=ButtonEvent;
  173.                 Mouseclicks:=1;
  174.                 Mousebutton:=1;
  175.                 Akt:= Item;
  176.             END(*IF*);
  177.          END(*IF*);
  178.          IF Last # Akt THEN
  179.              UpDate(PopTree,Last,Akt);
  180.          END(*IF*);
  181.     UNTIL (event=ButtonEvent) AND (Mouseclicks>0) AND (Mousebutton>0);
  182.     UpDate(PopTree,Akt,0);
  183.     GrafMouse(MouseOff,NIL);
  184.     (* Bildschirmhintergrund wieder herstellen *)
  185.     CopyMemToScreen(x-2,y-2,dw+6,dh+6,Buffer,TRUE);
  186.     GrafMouse(MouseOn,NIL);
  187.     IF ~and(GetObjectState(Akt,PopTree),Disabled) THEN
  188.        RETURN Akt;
  189.     ELSE
  190.        RETURN -1
  191.     END(*IF*);
  192. END  PopUp;
  193.  
  194. END PopUpMenue.
  195.